Cream of the Crop 1/Cream of the Crop 1.iso/COMM/PORTTEST.ARJ/TALK.PAS

Pascal/Delphi Source File | 1991-09-16 | 6KB | 179 lines

{\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
The contents of this file are not copyrighted.  Use it any way you want to.

        File : TALK.PAS
        Type : Mainline
    Language : TP6
    Revision : 1.0
      Author : Robert C. Henningsgard
        Date : 091691
 Description : COM port test talker.

               Uses the Asynch Plus communications library
               from Blaise Computing Inc, 2560 Ninth Street, Suite 316,
               Berkeley, CA 94710 (415-540-5441).

\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
uses DOS,CRT,TURBOEXT,UNIT_A0,UNIT_A1;

const
  ProgramName = 'TALK - RS-232C Port Exerciser';
  ProgramRevision = '1.0';
  Copyright =
    'Freeware - Committed to the public domain 1991 by Rob Henningsgard.';
  TimeOutMs = 5000;

const
  InQSize = 256;
  OutQSize = 256;
  BufferOverhead = 4;
  MinPort = 1;
  MaxPort = 4;

type
  Buf = array[1..InQSize+OutQSize+BufferOverhead] of byte;
  BufferArray = array[MinPort..MaxPort] of Buf;

var
  CommunicationsInitialized : array[MinPort..MaxPort] of boolean;
  InterCharacterDelay : array[MinPort..MaxPort] of integer;
  Buffer : BufferArray;

function COMAddress(I : integer) : word;
begin
  if (I >= 1) and (I <= 4)
    then COMAddress := memw[0:($400 + 2*pred(I))]
    else COMAddress := 0;
end;

procedure Async_Send(PortNumber : word;C : char);
begin
  while (__WrtChA1(PortNumber,C) = _Out_Q_Full) and
        (not keypressed) do begin                   { Queue is full }
    asm         { This calls the DOS idle interrupt.  It's a good idea to }
      int $28   { call it whenever you're going to cool your heels for    }
    end;        { a while.  It lets stuff like networks, printers, and    }
    delay(1);   { other background processes get a chance at the CPU.     }
  end;
end; { Async_Send }

function AsyncReceive(PortNumber : word;var C : char) : boolean;
var
  W,InQSize,PortStatus : word;
begin
  W := __RdChA1(PortNumber,C,InQSize,PortStatus);
  AsyncReceive := (W = 0);
end; { AsyncReceive}

procedure Finish_Communications(PortNumber : word);
{
Close port and drop DTR
}
var
  W : word;
begin { Finish_Communications }
  if CommunicationsInitialized[PortNumber] then begin
    W := __CloseA1(PortNumber);
    CommunicationsInitialized[PortNumber] := false;
  end;
end; { Finish_Communications }

function InitCommunications(PortNumber,BaudRate,Delay : integer) : boolean;
const
  IntLevel = 0;
  PortAds = 0;
  NoParity = 0;
  EightDataBits = 3;
  OneStopBit = 0;
  NoXONXOFF = 0;
  NoBit7Trimming = 0;
  NoBit7Forcing = 0;
  DoNotRequireCTS = 0;

var
  W : word;
  BaudVar : integer;
begin { InitCommunications }
  InitCommunications := false;
  if (BaudRate mod 150 <> 0) then exit; { illegal }
  BaudVar := 8;
  while (BaudRate < 19200) do begin { set up Asynch Plus baud number   }
    BaudRate := BaudRate * 2;       { where 8=19200, 7=9600, 6=4800... }
    dec(BaudVar);
  end;
  if (PortNumber in[MinPort..MaxPort]) and __LCOMOKA1 then begin
    if (__OpenA1(PortNumber,InQSize,OutQSize,IntLevel,
                 PortAds,@Buffer[PortNumber]) <> 0) then exit;
    if (__SetOpA1(PortNumber,1,BaudVar) <> 0) then exit;
    if (__SetOpA1(PortNumber,2,NoParity) <> 0) then exit;
    if (__SetOpA1(PortNumber,3,EightDataBits) <> 0) then exit;
    if (__SetOpA1(PortNumber,4,OneStopBit) <> 0) then exit;
    if (__SetOpA1(PortNumber,5,NoXONXOFF) <> 0) then exit;
    if (__SetOpA1(PortNumber,6,NoXONXOFF) <> 0) then exit;
    if (__SetOpA1(PortNumber,9,DoNotRequireCTS) <> 0) then exit;
    InitCommunications := true;
    InterCharacterDelay[PortNumber] := Delay;
    CommunicationsInitialized[PortNumber] := true;
  end;
end; { InitCommunications }

var
  I : integer;
  Port,Baud : integer;
  S : string;
  C : char;

begin { Listen }
  writeln(ProgramName,' Rev ',ProgramRevision);
  writeln(Copyright);
  writeln;
  if (paramcount < 2) then begin
    writeln('TALK  PORT  BAUD');
    writeln('      |     |');
    writeln('      |     +-- the baud rate to listen at');
    writeln('      +-- the port number to listen to');
    halt;
  end;
  S := paramstr(1);
  val(S,Port,I);
  S := paramstr(2);
  val(S,Baud,I);
  if not ((Port > 0) and (Port < 4)) then begin
    writeln('Illegal Port number ',Port,'.  Must be in the range 1..4.');
    halt;
  end;
  if (COMAddress(Port) = 0) then begin
    writeln('There is no COM',Port,' installed in this machine.');
    halt;
  end;
  if not ((Baud > 74) and (Baud < 19201)) then begin
    writeln('Illegal Baud rate ',Baud,'.  Must be in the range 75..19200.');
    halt;
  end;
  clrscr;
  writeln(ProgramName,' Rev ',ProgramRevision);
  writeln(Copyright);
  writeln;
  writeln('Talking to port ',Port,' at ',Baud,' baud.  Press any key to quit.');
  window(1,6,80,22);
  clrscr;
  for I := MinPort to MaxPort do CommunicationsInitialized[I] := false;
  if not InitCommunications(Port,Baud,0) then begin
    writeln('Unable to initialize the port.');
    halt;
  end;
  I := 1;
  S := ProgramName + ' ' + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'+#13+#10;
  while not keypressed do begin
    if (I > length(S)) then I := 1;
    Async_Send(Port,S[I]);
    write(S[I]);
    inc(I);
  end;
  while keypressed do C := readkey;
  Finish_Communications(Port);
  window(1,1,80,24);
  gotoxy(1,23);
  writeln(ProgramName,' ended.');
end. { Listen }